home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / cg.lha / cg / src / mod0.puma < prev    next >
Text File  |  1992-11-24  |  13KB  |  578 lines
  1. TRAFO GramMod
  2. TREE Tree
  3. PUBLIC ParsSpec ScanSpec
  4.  
  5. GLOBAL {
  6.  
  7. FROM IO        IMPORT WriteS, WriteNl;
  8. FROM Strings    IMPORT tString, ArrayToString;
  9. FROM StringMem    IMPORT WriteString;
  10. FROM Idents    IMPORT NoIdent, tIdent, MakeIdent;
  11. FROM Texts    IMPORT WriteText;
  12. FROM Sets    IMPORT IsElement, Include;
  13. FROM TreeMod2    IMPORT TreeIO;
  14.  
  15. FROM Tree    IMPORT
  16.    NoTree    , tTree        , Input        , Reverse    ,
  17.    Class    , NoClass    , Child        , Attribute    ,
  18.    ActionPart    , HasSelector    , HasAttributes    , NoCodeAttr    ,
  19.    Referenced    , Options    , TreeRoot    , QueryTree    ,
  20.    ClassCount    , iNoTree    , itTree    , Generated    ,
  21.    f        , WI, WE, WN    , ForallClasses    , ForallAttributes,
  22.    Nonterminal    , Terminal    , IdentifyAttribute,
  23.    String    , iPosition    ;
  24.  
  25. IMPORT Strings;
  26.  
  27. VAR
  28.    Node, ActClass, TheClass, TheAttr    : tTree;
  29.    iOper, iLeft, iRight, iNone, iPrec, iRule    : tIdent;
  30.    ActActionIndex, PrevActionIndex, i    : SHORTCARD;
  31.    IsImplicit                : BOOLEAN;
  32.    s                    : tString;
  33.  
  34. PROCEDURE GetBaseClass (Class: tTree): tTree;
  35.    BEGIN
  36.       WHILE Class^.Class.BaseClass^.Kind # NoClass DO
  37.      Class := Class^.Class.BaseClass;
  38.       END;
  39.       RETURN Class;
  40.    END GetBaseClass;
  41.  
  42. PROCEDURE IsLast (Class, Action: tTree): BOOLEAN;
  43.    VAR Found, Last: BOOLEAN;
  44.    BEGIN
  45.       IsLast2 (Class, Action, Found, Last);
  46.       RETURN Last;
  47.    END IsLast;
  48.  
  49. PROCEDURE IsLast2 (t, Action: tTree; VAR pFound, pLast: BOOLEAN);
  50.    VAR Found, Last: BOOLEAN;
  51.    BEGIN
  52.       CASE t^.Kind OF
  53.       | Class:
  54.         IsLast2 (t^.Class.Attributes, Action, pFound, pLast);
  55.         IF pFound OR NOT pLast THEN RETURN; END;
  56.         IsLast2 (t^.Class.BaseClass, Action, pFound, pLast);
  57.       | Child:
  58.         IsLast2 (t^.Child.Next, Action, Found, Last);
  59.         pFound := Found;
  60.         IF Found THEN
  61.            pLast := Last;
  62.         ELSE
  63.            pLast := FALSE;
  64.         END;
  65.       | Attribute:
  66.         IsLast2 (t^.Attribute.Next, Action, pFound, pLast);
  67.       | ActionPart:
  68.         IsLast2 (t^.ActionPart.Next, Action, Found, Last);
  69.         pFound := Found OR (Action = t);
  70.         IF Found THEN
  71.            pLast := Last;
  72.         ELSE
  73.            pLast := Last AND (Action = t);
  74.         END;
  75.       ELSE
  76.         pFound := FALSE;
  77.         pLast  := TRUE;
  78.       END;
  79.    END IsLast2;
  80. }
  81.  
  82. BEGIN {
  83.    ArrayToString ("OPER"    , s); iOper    := MakeIdent (s);
  84.    ArrayToString ("RIGHT"    , s); iRight    := MakeIdent (s);
  85.    ArrayToString ("LEFT"    , s); iLeft    := MakeIdent (s);
  86.    ArrayToString ("NONE"    , s); iNone    := MakeIdent (s);
  87.    ArrayToString ("PREC"    , s); iPrec    := MakeIdent (s);
  88.    ArrayToString ("RULE"    , s); iRule    := MakeIdent (s);
  89. }
  90.  
  91. PROCEDURE ParsSpec (t: Tree)
  92.  
  93. Ag (..) :- {
  94.     IF ScannerName # NoIdent THEN
  95.        !SCANNER ! WI (ScannerName);
  96.     END;
  97.     ! PARSER ! WI (ParserName); !!
  98.     !GLOBAL {!
  99.     WriteText (f, ParserCodes^.Codes.Global);
  100.     Node := Modules;
  101.     WHILE Node^.Kind = Tree.Module DO
  102.        WriteText (f, Node^.Module.ParserCodes^.Codes.Global);
  103.        Node := Node^.Module.Next;
  104.     END;
  105.     !TYPE!
  106.         ParsVariant (Classes);
  107.     !!
  108.     !tParsAttribute = RECORD CASE : SHORTCARD OF!
  109.     !  0: Scan: ! 
  110.     IF ScannerName # NoIdent THEN WI (ScannerName); ELSE !Scanner! END;
  111.     !.tScanAttribute;!
  112.     i := 0;
  113.     Node := Classes;
  114.     WHILE Node^.Kind = Class DO
  115.       WITH Node^.Class DO
  116.          IF {Nonterminal, Referenced, HasAttributes} <= Properties THEN
  117.            INC (i);
  118.            !| ! WN (i); !: ! 
  119.            IF (String IN Properties) AND NOT (HasSelector IN Properties) THEN
  120.          !(* ! WE (Name); ! *) yy! WN (Name);
  121.          !: yy! WN (Name); !;!
  122.            ELSE
  123.          WI (Selector); !: yy! WI (Selector); !;!
  124.            END;
  125.          END;
  126.          Node := Next;
  127.       END;
  128.     END;
  129.     !END; END;!
  130.     !}!
  131.     !!
  132.     !EXPORT {!
  133.     WriteText (f, ParserCodes^.Codes.Export);
  134.     Node := Modules;
  135.     WHILE Node^.Kind = Tree.Module DO
  136.       WriteText (f, Node^.Module.ParserCodes^.Codes.Export);
  137.       Node := Node^.Module.Next;
  138.     END;
  139.     !}!
  140.     !!
  141.     !LOCAL {!
  142.     WriteText (f, ParserCodes^.Codes.Local);
  143.     Node := Modules;
  144.     WHILE Node^.Kind = Tree.Module DO
  145.       WriteText (f, Node^.Module.ParserCodes^.Codes.Local);
  146.       Node := Node^.Module.Next;
  147.     END;
  148.     !}!
  149.     !!
  150.     !BEGIN {!
  151.     WriteText (f, ParserCodes^.Codes.Begin);
  152.     Node := Modules;
  153.     WHILE Node^.Kind = Tree.Module DO
  154.       WriteText (f, Node^.Module.ParserCodes^.Codes.Begin);
  155.       Node := Node^.Module.Next;
  156.     END;
  157.     !}!
  158.     !!
  159.     !CLOSE {!
  160.     WriteText (f, ParserCodes^.Codes.Close);
  161.     Node := Modules;
  162.     WHILE Node^.Kind = Tree.Module DO
  163.       WriteText (f, Node^.Module.ParserCodes^.Codes.Close);
  164.       Node := Node^.Module.Next;
  165.     END;
  166.     !}!
  167.     !!
  168.     !TOKEN!
  169.     !!
  170.     ForallClasses (Classes, Token);
  171.     !!
  172.     !OPER!
  173.     !!
  174.     PrecDefs (Precs);
  175.     !!
  176.     !RULE!
  177.     !!
  178.     ForallClasses (Classes, ParsSpec);
  179. }; .
  180. Class (..) :- {
  181.     IF {Nonterminal, Referenced} <= Properties THEN
  182.        TheClass := t;
  183.        Grammar (t);
  184.     END;
  185. }; .
  186.  
  187.  
  188. PROCEDURE ScanSpec (t: Tree)
  189.  
  190. Ag (..) :- {
  191.     !m!
  192.     !TYPE!
  193.     ForallClasses (Classes, ScanVariant);
  194.     !!
  195.     !tScanAttribute = RECORD!
  196.     !Position: tPosition;!
  197.     !CASE : SHORTCARD OF!
  198.     ForallClasses (Classes, ScanAttr);
  199.     !END; END;!
  200.     !!
  201.     !PROCEDURE ErrorAttribute (Token: INTEGER; VAR pAttribute: tScanAttribute);!
  202.     !%%!
  203.     !PROCEDURE ErrorAttribute (Token: INTEGER; VAR pAttribute: tScanAttribute);!
  204.     !BEGIN!
  205.     ! pAttribute.Position := Attribute.Position;!
  206.     ! CASE Token OF!
  207.     ForallClasses (Classes, ErrorActions);
  208.     ! ELSE!
  209.     ! END;!
  210.     !END ErrorAttribute;!
  211.     !%%!
  212.     ForallClasses (Classes, ScanSpec);
  213. }; .
  214. Class (..) :- {
  215.     IF {Terminal, Referenced} <= Properties THEN
  216.        WN (Code);
  217.        IF HasAttributes IN Properties THEN    ! S ! 
  218.        ELSE                    ! N ! 
  219.        END;
  220.        IF (String IN Properties) AND NOT (HasSelector IN Properties) THEN
  221.           !yy! WN (Code);
  222.        ELSE
  223.           WI (Selector);
  224.        END;
  225.        ! ! WI (Name); !!
  226.     END;
  227. }; .
  228.  
  229.  
  230. PROCEDURE ErrorActions (t: Tree)
  231.  
  232. Class (..) :- {
  233.     IF {Terminal, Referenced, HasAttributes} <= Properties THEN
  234.       ! | (* ! WE (Name); ! *) ! WN (Code); !: !
  235.       TheClass := t;
  236.       ForallAttributes (t, ErrorActions);
  237.     END;
  238. }; .
  239. ActionPart (..) :- {
  240.     ErrorActions (Actions);
  241. }; .
  242. Assign (..) :- {
  243.     ErrorActions (Results); !:=! ErrorActions (Arguments); !;!
  244.     ErrorActions (Next);
  245. }; .
  246. Copy (..) :- {
  247.     ErrorActions (Results); ! := ! ErrorActions (Arguments); !;!
  248.     ErrorActions (Next);
  249. }; .
  250. TargetCode (..) :- {
  251.     ErrorActions (Code); !;!
  252.     ErrorActions (Next);
  253. }; .
  254. Order (..) :- {
  255.     ErrorActions (Next);
  256. }; .
  257. Check (..) :- {
  258.     IF Statement # NoTree THEN
  259.        IF Condition # NoTree THEN
  260.           !IF NOT (! ErrorActions (Condition); !) THEN ! ErrorActions (Statement); !; END;!
  261.        ELSE
  262.           ErrorActions (Statement); !;!
  263.        END;
  264.     ELSE
  265.        !IF ! ErrorActions (Condition); ! THEN END;!
  266.     END;
  267.     ErrorActions (Next);
  268. }; .
  269. Designator (..) :- {
  270.     WI (Selector); !:! WI (Attribute);
  271.     ErrorActions (Next);
  272. }; .
  273. Ident (..) :- {
  274.     TheAttr := IdentifyAttribute (TheClass, Attribute);
  275.     IF TheAttr # NoTree THEN
  276.        !pAttribute! 
  277.        IF Attribute = iPosition THEN
  278.            ELSIF (String IN TheClass^.Class.Properties) AND NOT (HasSelector IN TheClass^.Class.Properties) THEN
  279.           !.yy! WN (TheClass^.Class.Code);
  280.        ELSE
  281.           !.! WI (TheClass^.Class.Selector);
  282.        END;
  283.        !.! 
  284.     END;
  285.     WI (Attribute);
  286.     ErrorActions (Next);
  287. }; .
  288. Any (..) :- {
  289.     WriteString (f, Code);
  290.     ErrorActions (Next);
  291. }; .
  292. Anys (..) :- {
  293.     ErrorActions (Layouts);
  294.     ErrorActions (Next);
  295. }; .
  296. LayoutAny (..) :- {
  297.     WriteString (f, Code);
  298.     ErrorActions (Next);
  299. }; .
  300.  
  301.  
  302. PROCEDURE ScanVariant (t: Tree)
  303.  
  304. Class (..) :- {
  305.     IF {Terminal, Referenced, HasAttributes} <= Properties THEN
  306.           IF (String IN Properties) AND NOT (HasSelector IN Properties) THEN
  307.         !(* ! WE (Name); ! *) yy! WN (Code); ! = RECORD ! 
  308.       ELSE
  309.         !yy! WI (Selector); ! = RECORD ! 
  310.       END;
  311.       TheClass := t;
  312.       ForallAttributes (t, RecordField);
  313.       !END;!
  314.     END;
  315. }; .
  316.  
  317.  
  318. PROCEDURE ScanAttr (t: Tree)
  319.  
  320. Class (..) :- {
  321.     IF {Terminal, Referenced, HasAttributes} <= Properties THEN
  322.       !| ! WN (Code); !: ! 
  323.           IF (String IN Properties) AND NOT (HasSelector IN Properties) THEN
  324.         !(* ! WE (Name); ! *) yy! WN (Code); !: yy! WN (Code); !;!
  325.       ELSE
  326.         WI (Selector); !: yy! WI (Selector); !;!
  327.       END;
  328.     END;
  329. }; .
  330.  
  331.  
  332. PROCEDURE ParsVariant (t: Tree)
  333.  
  334. Class (..) :- {
  335.     IF {Nonterminal, Referenced, HasAttributes} <= Properties THEN
  336.           IF (String IN Properties) AND NOT (HasSelector IN Properties) THEN
  337.         !(* ! WE (Name); ! *) yy! WN (Name); ! = RECORD ! 
  338.       ELSE
  339.         !yy! WI (Selector); ! = RECORD ! 
  340.       END;
  341.       TheClass := t;
  342.       ForallAttributes (Attributes, RecordField);
  343.       GenExt (Extensions);
  344.       !END;!
  345.     END;
  346.     ParsVariant (Next);
  347. }; .
  348.  
  349.  
  350. PROCEDURE GenExt (t: Tree)
  351.  
  352. Class (..) :- {
  353.     ForallAttributes (Attributes, RecordField);
  354.     GenExt (Extensions);
  355.     GenExt (Next);
  356. }; .
  357.  
  358.  
  359. PROCEDURE Token (t: Tree)
  360.  
  361. Class (..) :- {
  362.     IF {Terminal, Referenced} <= Properties THEN
  363.        WriteName (Name); ! = ! WN (Code); !!
  364.     END;
  365. }; .
  366.  
  367.  
  368. PROCEDURE RecordField    /* TheClass    */ (t: Tree)
  369.  
  370. Attribute (..) :- {
  371.     IF (NoCodeAttr * Properties) = {} THEN 
  372.        IF (Nonterminal IN TheClass^.Class.Properties) OR (Name # iPosition) THEN
  373.           WI (Name); !: ! WI (Type); !; ! 
  374.        END;
  375.     END;
  376. }; .
  377.  
  378.  
  379. PROCEDURE PrecDefs (t: Tree)
  380.  
  381. LeftAssoc (..) :- {
  382.     !LEFT ! PrecDefs (Names); !!
  383.     PrecDefs (Next);
  384. }; .
  385. RightAssoc (..) :- {
  386.     !RIGHT! PrecDefs (Names); !!
  387.     PrecDefs (Next);
  388. }; .
  389. NonAssoc (..) :- {
  390.     !NONE ! PrecDefs (Names); !!
  391.     PrecDefs (Next);
  392. }; .
  393. Name (..) :- {
  394.     ! ! WI (Name);
  395.     PrecDefs (Next);
  396. }; .
  397.  
  398.  
  399. PROCEDURE Grammar (t: Tree)
  400.  
  401. Class (..) :- {
  402.     IF Extensions^.Kind = Tree.NoClass THEN        (* Low ? *)
  403.        WITH TheClass^.Class DO
  404.           IF String IN Properties THEN !yy! WN (Name); ELSE WriteName (Name); END;
  405.        END;
  406.        ! : ! 
  407.        ActClass := t;
  408.        PrevActionIndex := 0;
  409.        IsImplicit := FALSE;
  410.        ForallAttributes (t, Rule);
  411.        IF Prec # NoIdent THEN !PREC ! WI (Prec); ! ! END;
  412.        !.!
  413.        PrevActionIndex := 0;
  414.        IsImplicit := TRUE;
  415.        ForallAttributes (t, Implicit);
  416.     ELSE
  417.        Rule (Extensions);
  418.     END;
  419. }; .
  420.  
  421.  
  422. PROCEDURE Rule (t: Tree)
  423.  
  424. Class (..) :- {
  425.     Grammar (t);
  426.     Rule (Next);
  427. }; .
  428. Child (..) :- {
  429.     IF {String, Nonterminal} <= Class^.Class.Properties THEN !yy! WN (Type); ELSE WriteName (Type); END; ! ! 
  430. }; .
  431. ActionPart (..) :- {
  432.     IF IsLast (ActClass, t) THEN
  433.        !{! 
  434.        IF PrevActionIndex # 0 THEN
  435.           Node := GetBaseClass (TheClass);
  436.           WITH Node^.Class DO
  437.          IF HasAttributes IN Properties THEN
  438.             ! $$.! 
  439.             IF String IN Properties THEN !yy! WN (Name); ELSE WI (Name); END;
  440.             ! := $! WN (PrevActionIndex); !.! 
  441.             IF String IN Properties THEN !yy! WN (Name); ELSE WI (Name); END;
  442.             !;!
  443.          END;
  444.           END;
  445.        END;
  446.        Rule (Actions);
  447.        !} ! 
  448.     ELSE
  449.        !xx! WN (Name); ! ! 
  450.     END;
  451.     PrevActionIndex := ParsIndex;
  452. }; .
  453. Assign (..) :- {
  454.     Rule (Results); !:=! Rule (Arguments); !;!
  455.     Rule (Next);
  456. }; .
  457. Copy (..) :- {
  458.     Rule (Results); ! := ! Rule (Arguments); !;!
  459.     Rule (Next);
  460. }; .
  461. TargetCode (..) :- {
  462.     Rule (Code); !;!
  463.     Rule (Next);
  464. }; .
  465. Order (..) :- {
  466.     Rule (Next);
  467. }; .
  468. Check (..) :- {
  469.     IF Statement # NoTree THEN
  470.        IF Condition # NoTree THEN
  471.           !IF NOT (! Rule (Condition); !) THEN ! Rule (Statement); !; END;!
  472.        ELSE
  473.           Rule (Statement); !;!
  474.        END;
  475.     ELSE
  476.        !IF ! Rule (Condition); ! THEN END;!
  477.     END;
  478.     Rule (Next);
  479. }; .
  480. Designator (..) :- {
  481.     TheAttr := IdentifyAttribute (ActClass, Selector);
  482.     IF TheAttr # NoTree THEN
  483.       Node := TheAttr^.Child.Class;
  484.       IF Node # NoTree THEN
  485.         !$! 
  486.         IF NOT IsImplicit THEN
  487.            WN (TheAttr^.Child.ParsIndex);
  488.         ELSE
  489.            WN (SHORTINT (TheAttr^.Child.ParsIndex + 1 - ActActionIndex));
  490.         END;
  491.         IF Nonterminal IN Node^.Class.Properties THEN    (* nonterminal *)
  492.           Node := GetBaseClass (Node);
  493.           IF (String IN Node^.Class.Properties) AND NOT (HasSelector IN Node^.Class.Properties) THEN
  494.             !.yy! WN (Node^.Class.Name);
  495.           ELSE
  496.             !.! WI (Node^.Class.Name);
  497.           END;
  498.         ELSE                        (* terminal *)
  499.           !.Scan! 
  500.           IF Attribute = iPosition THEN
  501.           ELSIF (String IN Node^.Class.Properties) AND NOT (HasSelector IN Node^.Class.Properties) THEN
  502.             !.yy! WN (Node^.Class.Code);
  503.           ELSE
  504.             !.! WI (Node^.Class.Selector);
  505.           END;
  506.         END;
  507.         !.! WI (Attribute);
  508.       ELSE
  509.         WI (Selector); !:! WI (Attribute);
  510.       END;
  511.     ELSE
  512.       WI (Selector); !:! WI (Attribute);
  513.     END;
  514.     Rule (Next);
  515. }; .
  516. Ident (..) :- {
  517.     TheAttr := IdentifyAttribute (ActClass, Attribute);
  518.     Node := GetBaseClass (TheClass);
  519.     IF TheAttr # NoTree THEN
  520.       IF (String IN Node^.Class.Properties) AND NOT (HasSelector IN Node^.Class.Properties) THEN
  521.         !$$.yy! WN (Node^.Class.Name); !.! WI (Attribute);
  522.       ELSE
  523.         !$$.! WI (Node^.Class.Name); !.! WI (Attribute);
  524.       END;
  525.     ELSE
  526.       WI (Attribute);
  527.     END;
  528.     Rule (Next);
  529. }; .
  530. Any (..) :- {
  531.     WriteString (f, Code);
  532.     Rule (Next);
  533. }; .
  534. Anys (..) :- {
  535.     Rule (Layouts);
  536.     Rule (Next);
  537. }; .
  538. LayoutAny (..) :- {
  539.     WriteString (f, Code);
  540.     Rule (Next);
  541. }; .
  542.  
  543.  
  544. PROCEDURE Implicit (t: Tree)
  545.  
  546. ActionPart (..) :- {
  547.     IF NOT (Generated IN Properties) AND NOT IsLast (ActClass, t) THEN
  548.        INCL (Properties, Generated);
  549.        ActActionIndex := ParsIndex;
  550.        !xx! WN (Name); ! : {! 
  551.        IF PrevActionIndex # 0 THEN
  552.           Node := GetBaseClass (TheClass);
  553.           WITH Node^.Class DO
  554.          IF HasAttributes IN Properties THEN
  555.             ! $$.! 
  556.             IF String IN Properties THEN !yy! WN (Name); ELSE WI (Name); END;
  557.             ! := $! WN (SHORTINT (PrevActionIndex + 1 - ActActionIndex)); !.! 
  558.             IF String IN Properties THEN !yy! WN (Name); ELSE WI (Name); END;
  559.             !;!
  560.          END;
  561.           END;
  562.        END;
  563.        Rule (Actions);
  564.        !} .!
  565.     END;
  566.     PrevActionIndex := ParsIndex;
  567. }; .
  568.  
  569. PROCEDURE WriteName (Name: tIdent)
  570.  
  571. (iOper);
  572. (iLeft);
  573. (iRight);
  574. (iNone);
  575. (iPrec);
  576. (iRule)    :-    !\! WI (Name); .
  577. _    :-        WI (Name); .
  578.